home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / old-sort.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.2 KB  |  98 lines
  1. (* Copyright 1989,1990,1991 by AT&T Bell Laboratories *)
  2. signature SORT =
  3.   sig
  4.     (* pass the gt predicate as an argument *)
  5.      val sort : ('a * 'a -> bool) -> 'a list -> 'a list  
  6.      val sorted : ('a * 'a -> bool) -> 'a list -> bool  
  7.   end
  8.  
  9. structure Sort : SORT = struct
  10.  
  11. (* Industrial-strength quicksort.
  12.    Selects pivot from middle of input list.
  13.    Distributes elements equal to pivot "randomly" in the two output partitions.
  14.    Special-cases lists of 0, 1, or 2 elements.
  15. *)
  16. (* This sort function breaks the compiler!
  17.  * symptoms: cannot load mlyacc. - lg
  18.  
  19. fun quickSort (op > : ('x * 'x -> bool)) =
  20.   let fun splita(pivot,nil,less,greater)= qsort less @ (pivot :: qsort greater)
  21.         | splita(pivot,a::rest,less,greater) =
  22.                  if a>pivot then splitb(pivot,rest,less,a::greater)
  23.                     else splitb(pivot,rest,a::less,greater)
  24.       and splitb(pivot,nil,less,greater)= qsort less @ (pivot :: qsort greater)
  25.         | splitb(pivot,a::rest,less,greater) =
  26.                  if pivot>a then splita(pivot,rest,a::less,greater)
  27.                     else splita(pivot,rest,less,a::greater)
  28.       and split1a(pivot,0,_::r,less,greater) = splitb(pivot,r,less,greater)
  29.         | split1a(pivot,i,a::rest,less,greater) =
  30.                  if a>pivot then split1b(pivot,i-1,rest,less,a::greater)
  31.                     else split1b(pivot,i-1,rest,a::less,greater)
  32.       and split1b(pivot,0,_::r,less,greater) = splita(pivot,r,less,greater)
  33.         | split1b(pivot,i,a::rest,less,greater) =
  34.                  if pivot>a then split1a(pivot,i-1,rest,a::less,greater)
  35.                     else split1a(pivot,i-1,rest,less,a::greater)
  36.       and qsort (l as [a,b]) = if a>b then [b,a] else l
  37.         | qsort (l as _::_::_) = 
  38.            let fun getpivot (x::xr, _::_::rest, i) = getpivot(xr,rest,i+1)
  39.                  | getpivot (x::_, _,i) = split1a(x,i,l,nil,nil)
  40.             in getpivot(l,l,0)
  41.            end
  42.         | qsort l = l
  43.    in qsort
  44.   end
  45. *)
  46.  
  47. (* merge sort -- Damien Doligez *)
  48.  
  49. fun mergeSort (op > : ('x * 'x -> bool)) =
  50.   let fun make2List(a::b::rest,accum) =
  51.             make2List(rest,(if b>a then [a,b] else [b,a]) :: accum)
  52.         | make2List(l,accum) = l :: accum
  53.          
  54.       fun merge (L1 as h1 :: l1, L2 as h2 :: l2) =
  55.              if h1 > h2
  56.              then h2 :: (merge (L1, l2))
  57.              else h1 :: (merge (l1, L2))
  58.         | merge ([], l2) = l2
  59.         | merge (l1, []) = l1
  60.  
  61.       fun merge_step (l1 :: l2 :: T,accum) =
  62.           merge_step(T, merge(l1,l2)::accum)
  63.         | merge_step([h],accum) = h :: accum
  64.         | merge_step(nil,accum) = accum
  65.  
  66.       fun merge_sort [l] = l
  67.         | merge_sort nil = nil
  68.         | merge_sort L = merge_sort (merge_step(L,nil))
  69.   in fn [] => []
  70.       | l => merge_sort (make2List(l,nil))
  71.   end
  72.  
  73. (* insertion sort -- slow! *)
  74.  
  75. fun insertionSort (op > : ('x * 'x -> bool)) =
  76.     let fun s (a::b::c) =
  77.         let val (x,y) = if a>b then (b,a) else (a,b)
  78.         fun insert' [] = [y]
  79.           | insert' (l as c::d) = if y>c then c::insert' d else y::l
  80.         fun insert [] = [x,y]
  81.           | insert (l as c::d) = 
  82.             if x>c then c::insert d else x::insert' l
  83.         in insert(s c)
  84.         end
  85.       | s l = l
  86.     in s
  87.     end
  88.  
  89. val sort = mergeSort
  90.  
  91. fun sorted (op >) =
  92.   let fun s (x::(rest as (y::_))) = not(x>y) andalso s rest
  93.         | s l = true
  94.   in s
  95.   end
  96.  
  97. end
  98.